home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / vax / vaxmcode2.sml < prev   
Encoding:
Text File  |  1993-01-27  |  7.7 KB  |  269 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. structure VaxMCode : VAXMCODER = struct
  3.  
  4. structure Jumps = struct
  5.     datatype JumpKind = MODE | WHICH of (int ref * int * int)
  6.                 | BYTEDISPL
  7.             | LABPTR of int
  8.             | COND of (int ref * int * int) | JBR
  9. fun sbyte i = chr(if i<0 then 256+i else i)
  10. fun eword i =
  11.     if i<0 then eword(65536+i)
  12.     else [chr(i mod 256), chr(i div 256)]
  13. fun elong i =
  14.         if i<0 
  15.       then let val a = ~i;
  16.            val b = a mod 65536;
  17.            val c = a div 65536;
  18.         in eword(~b) @ eword(~c + if b=0 then 0 else ~1)
  19.            end
  20.       else eword(i mod 65536) @ eword(i div 65536)
  21. fun intsize(i) =
  22.         if i >= ~128 andalso i < 128
  23.         then 1
  24.     else if i >= ~32768 andalso i < 32768
  25.         then 2
  26.     else 4;
  27.  
  28.   fun emitlong i = implode(elong i)
  29.  
  30.   fun sizejump(mode,oldsize,s,d) =
  31.    let fun which (r,a,b) =
  32.             case oldsize of 1 => r := a | _ => r := b
  33.     in case (mode,intsize(d-(s+oldsize)))
  34.            of  (MODE,i) => i+1
  35.             | (LABPTR _, _) => 4
  36.         | (BYTEDISPL, _) => 1
  37.         | (WHICH _, _) => 1
  38.         | (COND x, _) => (which x; 7)
  39.         | (JBR,_) => 6
  40.    end
  41.  
  42.   fun emitjump(MODE,2,s,d) = chr(10*16+15) ^ sbyte(d-s-2)
  43.     | emitjump(MODE,3,s,d) = implode(chr(12*16+15) :: eword(d-s-3))
  44.     | emitjump(MODE,5,s,d) = implode(chr(14*16+15) :: elong (d-s-5))
  45.     | emitjump(BYTEDISPL,1,s,d) = sbyte(d-s-1)
  46.     | emitjump(LABPTR i, _,s,d) = emitlong(d-s+i)
  47.     | emitjump(WHICH(ref i,_,_), _,_,_) = chr i
  48.     | emitjump(COND _, 1,s,d) = sbyte(d-s-1)
  49.     | emitjump(COND _, 4,s,d) = implode(chr 3 :: chr(3*16+1) :: eword(d-s-4))
  50.     | emitjump(COND _, 7,s,d) = implode(chr 6 :: chr(16+7) :: chr(14*16+15) 
  51.                     :: elong (d-s-7))
  52.     | emitjump(JBR,2,s,d) = chr(16+1) ^ sbyte (d-s-2)
  53.     | emitjump(JBR,3,s,d) = implode(chr(3*16+1) :: eword (d-s-3))
  54.     | emitjump(JBR,6,s,d) = implode(chr(16+7):: chr(14*16+15) :: elong (d-s-6))
  55.     | emitjump _ = ErrorMsg.impossible "emitjump"
  56.   
  57. end (* Jumps *)
  58.  
  59. structure Emitter : BACKPATCH = Backpatch(Jumps)
  60.  
  61. structure Coder : VAXCODER = struct
  62.  
  63. open Emitter Jumps
  64.  
  65. fun emitbyte i = emitstring(chr i)
  66. fun signedbyte i = emitbyte(if i<0 then 256+i else i)
  67. fun emitword i =
  68.     if i<0 then emitword(65536+i)
  69.     else (emitbyte(i mod 256); emitbyte(i div 256));
  70. fun emitlong i =
  71.         if i<0 
  72.       then let val a = ~i;
  73.            val b = a mod 65536;
  74.            val c = a div 65536;
  75.         in emitword(~b);
  76.            emitword(~c + if b=0 then 0 else ~1)
  77.            end
  78.       else (emitword(i mod 65536); emitword(i div 65536))
  79. fun intsize(i) =
  80.         if i >= ~128 andalso i < 128
  81.         then 1
  82.     else if i >= ~32768 andalso i < 32768
  83.         then 2
  84.     else 4;
  85.  
  86. datatype Register = reg of int
  87.  
  88. val r0 = reg 0
  89. val r1 = reg 1
  90. val r2 = reg 2
  91. val r3 = reg 3
  92. val r4 = reg 4
  93. val r5 = reg 5
  94. val r6 = reg 6
  95. val r7 = reg 7
  96. val r8 = reg 8
  97. val r9 = reg 9
  98. val r10 = reg 10
  99. val r11 = reg 11
  100. val r12 = reg 12
  101. val r13 = reg 13
  102. val sp = reg 14
  103. val pc = reg 15
  104.  
  105. datatype EA = direct of Register
  106.         | autoinc of Register
  107.         | autodec of Register
  108.         | displace of int * Register
  109.         | deferred of int * Register
  110.         | immed of int
  111.         | immedlab of Label
  112.         | address of Label
  113.         | index of EA * Register
  114.  
  115. exception BadReal of string
  116.  
  117. (* This is identical to M68PrimReal except that emitword is different,
  118.    and the bias is off by two. *)
  119. structure VaxPrimReal : PRIMREAL =
  120. struct
  121. val significant = 53 (* 52 + redundant 1/2 bit *)
  122. fun outofrange s = raise(BadReal s)
  123. (* Convert a portion of a boolean array to the appropriate integer. *)
  124. exception Bits
  125. fun bits(a,start,width) =
  126.     let fun b true = 1
  127.       | b false = 0
  128.     fun f 0 = b (a sub start)
  129.       | f n = b (a sub (start+n)) + 2 * f(n-1)
  130.     in  if Array.length a < start+width orelse start < 0 orelse width < 0
  131.     then raise Bits
  132.     else f (width-1)
  133.     end
  134. fun emitreal (sign,frac,exp) =
  135.     let val exponent = exp + 1024
  136.     fun emit () =
  137.         let val word0 =
  138.             case frac sub 0 of (* zero? *)
  139.           true => Bits.orb(Bits.lshift(sign,15),
  140.                      Bits.orb(Bits.lshift(exponent,4),
  141.                            bits(frac,1,4)))
  142.         | false => 0
  143.         val word1 = bits(frac,5,16)
  144.         val word2 = bits(frac,21,16)
  145.         val word3 = bits(frac,37,16)
  146.         in  emitword word0;
  147.         emitword word1;
  148.         emitword word2;
  149.         emitword word3
  150.         end
  151.     in  if exponent < 1 orelse exponent > 2047
  152.     then outofrange "" (* A hack *)
  153.     else emit()
  154.     end
  155. end
  156. structure VaxRealConst = RealConst(VaxPrimReal)
  157. open VaxRealConst
  158.  
  159. fun regmode(mode,r) = emitbyte(mode*16+r)
  160.  
  161. fun emitarg (direct(reg r)) = regmode(5,r)
  162.   | emitarg (autoinc(reg r)) = regmode(8,r)
  163.   | emitarg (autodec(reg r)) = regmode(7,r)
  164.   | emitarg (immed i) = 
  165.        (emitarg(autoinc pc); emitlong i)
  166.   | emitarg (displace(i,reg r)) =
  167.           (regmode(14,r); emitlong i)
  168.   | emitarg (deferred(i,reg r)) =
  169.        (regmode(15,r); emitlong i)
  170.   | emitarg (index(ea, reg r)) = (regmode(4,r); emitarg ea)
  171.   | emitarg (address lab) = jump(MODE,lab) (* no good for branches *)
  172.  
  173. fun emit2arg (arg1,arg2) = (emitarg arg1; emitarg arg2)
  174.  
  175. fun emit3arg (arg1,arg2,arg3) = (emitarg arg1; emitarg arg2; emitarg arg3)
  176.  
  177. fun pure (autoinc _) = false
  178.   | pure (autodec _) = false
  179.   | pure _ = true
  180.  
  181. fun args23(f2,f3) (args as (a,b,c)) = f3 args
  182.  
  183. fun immedbyte(i) =
  184.          (emitarg(autoinc pc); signedbyte i);
  185.  
  186. fun immedword(i) =
  187.          (emitarg(autoinc pc); emitword i);
  188.  
  189. fun emitlab (i,lab) = jump(LABPTR i, lab)
  190.  
  191. fun jbr (address lab) = jump(JBR,lab)
  192. fun bbc (arg1, arg2, address lab) =
  193.         let val r = (ref 0, 14*16+1,14*16+0)
  194.          in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
  195.         end
  196. fun bbs (arg1, arg2, address lab) =
  197.         let val r = (ref 0, 14*16+0,14*16+1)
  198.          in jump(WHICH r, lab); emitarg arg1; emitarg arg2; jump(COND r, lab)
  199.         end
  200.  
  201. fun movb args = (emitbyte (9*16); emit2arg args)
  202.  
  203. fun movzbl args = (emitbyte (9*16+10); emit2arg args)
  204.  
  205. fun pushal args = (emitbyte (13*16+15); emitarg args)
  206.  
  207. fun addl2 args = (emitbyte (12*16); emit2arg args)
  208.  
  209. fun moval args = (emitbyte (13*16+14); emit2arg args)
  210.  
  211. fun movl args = (emitbyte (13*16); emit2arg args)
  212.  
  213. fun movq args = (emitbyte (7*16+13); emit2arg args)
  214.  
  215. fun rsb () = emitbyte 5
  216. fun cmpl args = (emitbyte (13*16+1); emit2arg args)
  217. fun addl3 args = (emitbyte (12*16+1); emit3arg args)
  218. val addl3 = args23 (addl2,addl3)
  219. fun subl2 args = (emitbyte (12*16+2); emit2arg args)
  220. fun subl3 args = (emitbyte (12*16+3); emit3arg args)
  221. val subl3 = args23 (subl2,subl3)
  222. fun bisl3 args = (emitbyte (12*16+9); emit3arg args)
  223. fun bicl3 args = (emitbyte (12*16+11); emit3arg args)
  224. fun xorl3 args = (emitbyte (12*16+13); emit3arg args)
  225. fun ashl args = (emitbyte (7*16+8); emit3arg args)
  226. fun mull2 args = (emitbyte (12*16+4); emit2arg args)
  227. fun divl3 args = (emitbyte (12*16+7); emit3arg args)
  228. fun divl2 args = (emitbyte (12*16+6); emit2arg args)
  229. val divl3 = args23 (divl2,divl3)
  230. fun jmp arg = (emitbyte (16+7); emitarg arg)
  231. fun brb (displace(i,reg 15)) = (emitbyte (16+1); signedbyte i)
  232. fun brw (displace(i,reg 15)) = (emitbyte (3*16+1); emitword i)
  233.  
  234. local fun condj(i,j) =
  235.     fn (address lab) => let val r = (ref 0,16+i,16+j)
  236.                      in jump(WHICH r, lab); jump(COND r, lab)
  237.                     end
  238.      | displace(k, reg 15) => (emitbyte (16+i); signedbyte k)
  239.  in val beql = condj(3,2)
  240.     val bneq = condj(2,3)
  241.     val jne = bneq
  242.     val bgeq = condj(8,9)
  243.     val bgtr = condj(4,5)
  244.     val blss = condj(9,8)
  245.     val bleq = condj(5,4)
  246. end
  247. fun sobgeq (arg,address lab) = (emitbyte (15*16+4); emitarg arg;
  248.                 jump(BYTEDISPL,lab))
  249.  
  250. fun movg args = (emitword(20733); emit2arg args)
  251. (* fun mnegg args = (emitword(21245); emit2arg args)*) 
  252. fun addg3 args = (emitword(16893); emit3arg args)
  253. fun subg3 args = (emitword(17405); emit3arg args)
  254. fun mulg3 args = (emitword(17917); emit3arg args)
  255. fun divg3 args = (emitword(18429); emit3arg args)
  256. fun cmpg args = (emitword(20989); emit2arg args)
  257.  
  258. fun push arg = movl(arg,autodec sp)
  259. fun pusha arg = pushal arg
  260. fun pop arg = movl(autoinc sp,arg)
  261.  
  262. fun comment _ = ()
  263.  
  264. end (* Coder *)
  265.  
  266. val finish = Emitter.finish
  267.  
  268. end (* structure MCode *)
  269.